１６個の要素をもつ体 GF (2^4) を用いて符号を構成する。

α は (α^4) + α + 1 をみたす数とする。

minimal = α^4 + α + 1

GF (2^4) のすべての要素を加法表示と乗法表示したもののリストを作る。

additive=Table[
PolynomialMod[α^(14-i),{minimal ,2}],
{i,0,14}]~
Join~{0}

multiplicative=Table[α^(14-i),{i,0,14}]~
Join~{0}

toA は加法表示に直すため、toM は乗法表示に直すための関数。

toA[elem_]:=PolynomialMod[elem,{minimal ,2}]

For[i= 1, i<16,i++,toM0[additive[[i]]]=α^(15-i)];
toM0[0]=0;
toM[elem_]:=toM0[PolynomialMod[elem,{minimal ,2}]]

符号を生成する多項式を８次式とし、情報ビット数７，訂正能力２の符号を作る。

generator =  (1+x+(x^2)+(x^3)+(x^4)) (1+x+(x^4))

encode は７次元ベクトルを１５次の符号多項式 （符号語） に直す関数。
まず７次元ベクトルから６次多項式を作り、それを生成多項式にかけて１５次多項式を作る。
decode はこれを元に戻す関数。生成多項式による商を取る。

encode[vector_]:=
PolynomialMod[
vector.Table[x^(Length[vector]-i),{i,1,Length[vector]}]*generator,{2}]

decode[polynomial_]:=
Coefficient[
PolynomialMod[PolynomialQuotient[polynomial,generator,x],2],
x,Table[7-i,{i,1,7}]]

具体例：k という文字を７次元ベクトルに直し、１５次の符号多項式に直す。

IntegerDigits[ToCharacterCode["k"],2][[1]]
sent=encode[%]

(x^5)+(x^12)というノイズを加えてみる。

received=PolynomialMod[sent+(x^5)+(x^12),2]

間違いを訂正せずに文字に戻してみる。

decode[received]
FromCharacterCode[%.Table[2^(7-i),{i,1,7}]]

シンドロームを計算する

s0=toM[received/.x->α]
s1=toM[received/.x->α^3]

誤りを解に持つ２次方程式を作る。定数項は(((s0^3)+s1)/s0)であるが、s0 による割り算を計算するのが少し面倒。

eq=X^2 + s0 X +Power[α,Mod[Exponent[toM[s0^3+s1],α]- Exponent[s0,α],15]]

(α^i)を次々に代入し０になる場所を見る。５番目と１２番目が０になっているはず。

Table[PolynomialMod[eq/.X->α^i,{minimal,2}],{i,1,15}]

ランダムにノイズを加え,メッセージがどのように伝わるかを見てみる。

noise[]:=Sum[If[RandomReal[]<0.05,1,0]x^(15-i),{i,1,15}]

detect[received_]:=Block[{s0,s1,eq},
s0=toM[received/.x->α];
s1=toM[received/.x->α^3];
eq=X^2 + s0 X +If[toM[s0^3+s1]===0,0,
Power[α,Mod[Exponent[toM[s0^3+s1],α]- Exponent[s0,α],15]]];

Which[s0===0,"-",Count[Table[PolynomialMod[eq/.X->α^i,{minimal,2}],{i,1,15}],0]>0,
Flatten[
Position[Table[PolynomialMod[eq/.X->α^i,{minimal,2}],{i,1,15}],0]],
True,Print["Too many errors!"]]]

correct[received_]:=Block[{s0,s1,eq},
s0=toM[received/.x->α];
s1=toM[received/.x->α^3];
eq=X^2 + s0 X +If[toM[s0^3+s1]===0,0,
Power[α,Mod[Exponent[toM[s0^3+s1],α]- Exponent[s0,α],15]]];

Which[s0===0,received,Count[Table[PolynomialMod[eq/.X->α^i,{minimal,2}],{i,1,15}],0]>0,
PolynomialMod[received+
Total[x^#&/@Flatten[
Position[
Table[PolynomialMod[eq/.X->α^i,{minimal,2}],{i,1,15}],0]]],2],
True,Print["Too many errors!"]]]

encodedlist[string_]:=code/@(IntegerDigits[#,2]&/@ ToCharacterCode[string])

addnoise[list_]:=PolynomialMod[(#+noise[]),2]&/@ list

decodelist[list_]:=FromCharacterCode[
Coefficient[
PolynomialMod[PolynomialQuotient[#,generator,x],2],
x,Table[7-i,{i,1,7}]].Table[2^(7-i),{i,1,7}]&/@list]

sent=encodedlist["kuwata@tamacc.chuo-u.ac.jp"]

received=addnoise[sent]

どこに間違いがあるかを見つける。

detect/@ received

間違いを訂正して元に戻す。

collect/@ received

decodelist[received]

decodelist[collect/@ received]